PDA

View Full Version : کد های ماورایی



pcdownload.bloghaa.com
شنبه 27 فروردین 1390, 13:20 عصر
سلام

هدف از ایجاد این تاپیک قرار دادن کدهای کاملا شخصی هست که در برخی موارد بسیار هم جالب هستن.
اما قبل از قرار دادن کدها چند تا نکته را عرض کنم بعد:
1.اینجا کدهای جالب و شخصی را قرار میدیم و با هیچ شرکت و سازمانی هم کار نداریم حالا یه کد مینویسیم 5 نفر میان گیر میدن که مایروسافت گفته فلان و فلان... خوب به حرف مایکروسافت گوش کن و اسفاده نکن اجباری که نیست.
2.هر دستوری که توی یه زبان گذاشتن برای اسفاده کردن گذاشتن یکی پیدا شده بود میگفت که دستور goto منسوخ شده و نباید ازش تو ویژوال بیسیک استفاده کرد.آخه یکی نیست بگه اگه از goto اسفاده نکنیم پس چجوری باید خطاها رو کنترل کنیم.اینو به این صورت گفتن که تو زبان های جدید از goto استفاده نمیشه نه اینکه تو یه زبان که goto داخلش هست استفاده نکنیم.
3.هر کس کد شخصی نه کپی شده داره که خودش نوشته و جالبه (نه اینکه برداره کد تشخیص عدد اول را اینجا بتویسه) میتونه اینجا قرار بده و لطفا از قرار دادن پست های بیهوده خودداری کنید.

pcdownload.bloghaa.com
شنبه 27 فروردین 1390, 13:31 عصر
قرار دادن شرط در برنامه بدون استفاده از if و select و...

کد زیر را در نظر بگیرید:

if 2<1 then
msgbox "hello"
else
msgbox "bye"
end if
حالا به نظر شما بدون استفاده از دستورات شرط مثل if یا select میشه همچین کدی را نوشت
مسلما نه.اما نظر من این نیست چون برای هرکاری(هرکاری) یه راهکاری هم هست.

تابع زیر هم همین کار را انجام میده بدون استفاده از دستورات شرطی.


Private Sub if_p(k As Boolean)
Dim t As Long
On Error GoTo b:
t = 1 / k
msgbox "hello"
Exit Sub
b:
msgbox "bye"
End Sub

کافیه بنویسیم:


if_p (2 < 1)

اگه این مطلب براتون جالب یا مفید بود لطفا تشکر فراموش نشه(زدن دکمه تشکر)
کپی برداری هم با ذکر منبع مشکلی نداره.

vbhamed
شنبه 27 فروردین 1390, 20:48 عصر
سلام

فكر كنم بهتره براي كدهايي كه مي نويسيد كاربرد مفيدش رو هم ذكر كنيد
خيلي كارها رو شايد بشه با روشهاي غير معمول انجام داد، اما بايد ديد در نهايت چه سودي داره

parselearn
شنبه 27 فروردین 1390, 21:43 عصر
اين كد يعني حتما بايد به خطا برخورد كنيم تا يكي از شرايط اعمال بشه. در صورتي كه بايد سعي بشه برنامه خطايي نداشته باشه


Private Sub if_p(k As Boolean)
Dim t As Long
On Error GoTo b:
t = 1 / k
msgbox "hello"
Exit Sub
b:
msgbox "bye"
End Sub



مطلب جالبي نبود

pcdownload.bloghaa.com
شنبه 27 فروردین 1390, 22:35 عصر
سود این روش اینه که خودتونو آزمایش کنید و ببینید که برای حل یه مساله سخت تا چه حد کشش دارید.
اگه بتونید چنین مسایلی را حل کنید منجر میشه تا ذهنتون برای حل مسایل سختتر و کاربردی تر آماده بشه.
در مورد خطا هم قرار نیست تو هیچ برنامه ای خطا رخ نده قرار هست که خطای ایجاد شده کنترل بشه.

اگه با این کد حال نکردین کد بعدی را حتما ببینید.

pcdownload.bloghaa.com
شنبه 27 فروردین 1390, 22:51 عصر
الگوریتم فشرده سازی متن(به روش خودم)

یه روز داشتم با کاراکتر ها و بیت ها روی کاغذ ور میرفتم که یه روش فشرده سازی به ذهنم رسید که
اول پیاده سازیش کردم و بعد بهینه سازی.

الگوریتم :

در فایل های متنی از کاراکتر های 1 تا 31 بغیر از کاراکتر 13 استفاده نمیشه.
خوب حالا متن مورد نظر را 2کاراکتر 2 کاراکتر از هم جدا میکنیم.
بعد تعداد تکرار این دوکاراکتر ها را در متن پیدا میکنیم.
بعد از پیدا کردن 30 تا دوحرفی که بیشترین تکرار را در متن دارن را جدا میکنیم.
بعد این 30 تا دو حرفی را بترتیب در ابتدای فایل جدید قرار میدیم.
بعد در کل متن اولیه همه این دو حرفی ها را با کاراکتر معادل شماره آن جایگزین میکنیم.
یعنی اون دو کاکتری های با تکرار بالا را تبدیل میکنیم به 1 کاراکتر.(فشرده سازی).
بعد متن اولیه تغییر یافته را هم به نتیجه اضافه کرده و فایل جدید را که یک فایل باینریست ذخیره میکنیم.
و تمام برای باز یابی هم روشی مشابه برکس این روش را انجام میدیم.

کدشم ایشالا پست بعدی.چون دیگه الان نصفه شبه و کد نویسی هم زمان میبره.