Последние записи

made in programmersforum 5

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw

6th
Окт

Как расчитать время между нажатием и отпусканием кнопки мыши?

var  time1, time2, time3: TTime; //Глобальные
procedure TForm1.RzBitBtn1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  time1 := Time;
end;
procedure TForm1.RzBitBtn1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var h, m, s, ms: Word;
  st: string;
  d: Double;
begin                           
  time2 := Time;
  time3 := time2 – time1;
  DecodeTime(time3, h, m, s, ms);
  st := IntToStr(s) + ‘.’ + IntToStr(ms);
  d := RoundTo(StrToFloat(st), -1);
  label1.Caption := FloatToStr(d);
end;

Тема на форуме

Добавлено в Пост-обзор. Дата Октябрь 6th, 2010

5th
Окт

Как получить классы всех дочерних окон формы?

function EnumClasses(HWND:THandle;lParam:Integer):BOOL;stdcall;
var s:string;
begin
SetLength(s,256);
SetLength(s,GetClassName(HWND,s[1],256));
   Form1.Memo1.Lines.Add(s);
   Result:=true;
end;
на кнопке пишем
   EnumChildWindows(<хендл окна, у которого перечисляем>,@EnumClasses,0);

Тема на форуме

Добавлено в Пост-обзор. Дата Октябрь 5th, 2010

4th
Окт

Изменение курсора

Пишите процедуру типа

procedure TForm1.LC(p: integer; s: PAnsiChar);
begin
  Screen.Cursors[p] := LoadCursor(HInstance,s);
  Image1.Cursor:=TCursor(p);
end;

Вместо Image1 Ваш элемент,для кот. должен появляться Ваш курсор.
Пример использования:

LC(2,’oval’);

‘oval’ – имя курсора из файла *.res.
В коде формы подключите Ваш res-файл,например, {$R MyFile.RES}
Файл с ресурсами создаёте заранее,например в Image Editor (стандартный Борландовский: Меню Tool->Image Editor) – он будет содержать Ваши курсоры.

Если что-то не получится во вложении пример программы и скриншот. Писал 1,5-2 года назад,как курсовую. Тогда ещё много чего не знал(да и сейчас не всё знаю:),так что код очень корявый,но рабочий. Перед запуском программы скопируйте папку “КРАБ” на диск С.
КР(NEW)!!!.zip

Тема на форуме

Добавлено в Пост-обзор. Дата Октябрь 4th, 2010

3rd
Окт

Gecko. Как его использовать в дельфи?

Установка, полезные ссылки, различные решения проблем. Читать тему на форуме

Добавлено в Топик-обзор. Дата Октябрь 3rd, 2010

3rd

Организация цикла While в ассемблере

Можно макроинструкциями:

.WHILE TRUE
invoke GetMessage,ADDR msg,0,0,0
.BREAK .IF (!eax)
invoke TranslateMessage,ADDR msg
invoke DispatchMessage,ADDR msg
.ENDW

Это пример из МАСМ.

Тема на форуме

Добавлено в Пост-обзор. Дата Октябрь 3rd, 2010

3rd

Cравнить две строки. asm

Нужно сделать по аналогии с strcmp (на Си). Если первая строка меньше второй вывести -1, если равны 0, иначе 1.

.686P
.model flat
.data
string1 db ‘мама мыла раму’,0
string2 db ‘мама не мыла раму’,0
.code
start:     mov esi,offset string1
         mov ecx,offset string2
         call strcmp
         mov esi,offset string2
         mov ecx,offset string1
         call strcmp
         mov esi,offset string1
         mov ecx,offset string1
strcmp proc
@@:     lodsd
         cmp al,[ecx]
         jnz short a3
         or al,al
         jz short @f
         cmp ah,[ecx+1]
         jnz short a3
         or ah, ah
         jz short @f
         shr eax,10h
         cmp al,[ecx+2]
         jnz short a3
         or al,al
         jz short @f
         cmp ah,[ecx+3]
         jnz short a3
         add ecx,4
         or ah,ah
         jnz short @b
@@:     xor eax,eax
         retn
a3:     sbb eax,eax
         or eax,1
         retn
strcmp endp
end start

Тема на форуме

Добавлено в Пост-обзор. Дата Октябрь 3rd, 2010

3rd

Действия над числами в строке

вот такой вроде не сложный но в тоже время интересный вопрос, как сделать действия над числами если они все в одной строке и разделены знаками, например:
S:=’1+2+2-3+5-1=’;

function Calculate(SMyExpression: string; digits: Byte): string;
var
   z: Char;
   ipos: Integer;
   function StrToReal(chaine: string): Real;
   var
     r: Real;
     Pos: Integer;
   begin
     Val(chaine, r, Pos);
     if Pos > 0 then Val(Copy(chaine, 1, Pos – 1), r, Pos);
     Result := r;
   end;
   function RealToStr(inreal: Extended; digits: Byte): string;
   var
     S: string;
   begin
     Str(inreal:0 : 0, S);
     realToStr := S;   
   end;   
   procedure NextChar;   
   var  
     s: string;   
   begin
     if ipos > Length(SMyExpression) then  
     begin  
       z := #9;   
       Exit;
     end  
     else
     begin
       s := Copy(SMyExpression, ipos, 1);
       z := s[1];   
       Inc(ipos);   
     end;   
     if z = ‘ ‘ then nextchar;
   end;   
   function Expression: Real;
   var
     w: Real;
     function Factor: Real;
     var  
       ws: string;
     begin
       Nextchar;   
       if z in [‘0′..‘9′] then
       begin  
         ws := ”;
         repeat  
           ws := ws + z;
           nextchar   
         until not (z in [‘0′..‘9′, ‘.’]);
         Factor := StrToReal(ws);
       end  
       else if z = ‘(’ then  
       begin
         Factor := Expression;
         nextchar   
       end
       else if z = ‘+’ then Factor := +Factor   
       else if Z = ‘-’ then Factor := -Factor;   
     end;
    
     function Term: Real;
     var  
       W: Real;
     begin
       W := Factor;
       while Z in [‘*’, ‘/’] do  
         if z = ‘*’ then w := w * Factor
       else
         w := w / Factor;
       Term := w;   
     end;
   begin  
     w := term;
     while z in [‘+’, ‘-’] do
       if z = ‘+’ then w := w + term
     else  
       w := w – term;
     Expression := w;
   end;
begin
   ipos   := 1;
   Result := RealToStr(Expression, digits);
end;

вызов:

s:=‘1+2*5+3+(5*2+7)’;
s:=calculate(s,0);

Тема на форуме

Добавлено в Пост-обзор. Дата Октябрь 3rd, 2010

3rd

Как получить список отмеченных Checkbox’ов

Как получить список отмеченных Checkbox’ов. Нужно, чтобы список отображался в Memo или ListBox.

var
  i: integer;
begin
  for i := 0 to Form1.ControlCount – 1 do
  begin
    if (Form1.Controls[i] is TCheckBox) then
      if (Form1.Controls[i] as TCheckBox).Checked then
      Memo1.Lines.Add((Form1.Controls[i] as TCheckBox).Caption&#4

1;
  end;
end

Тема на форуме

Добавлено в Пост-обзор. Дата Октябрь 3rd, 2010

3rd

Вставить иконку в ячейку DBGridEh

Надо показать иконку в ячейке вместе с текстом. То есть слева в ячейке иконка, а за ней текст.

var cc: TCanvas;
begin
  if (DataCol = 0) then
  begin
    Icon := TIcon.Create;
    Icon.LoadFromFile(‘user1_16.ico’);
    cc := DBGridEh1.Canvas;
    cc.FillRect(rect);
    cc.Draw(Rect.Left, Rect.Top, Icon);
    cc.TextOut(Rect.Left + 20, Rect.Top, DBGridEh1.DataSource.DataSet.Fields[0].AsString);
    Icon.Free;
 end;

Тема на форуме

Добавлено в Пост-обзор. Дата Октябрь 3rd, 2010

1st
Окт

Загрузка BMP в Simple Graph и сохранение в BMP формат

function TSimpleGraph.GetAsMetafile: TMetafile; var I: Integer; GraphRect: TRect; MetaCanvas: TMetafileCanvas; begin GraphRect := GraphBounds; Result := TMetafile.Create; Result.Width := GraphRect.Right - GraphRect.Left; Result.Height := GraphRect.Bottom - GraphRect.Top; MetaCanvas := TMetafileCanvas.Create(Result, 0); try SetViewportOrgEx(MetaCanvas.Handle, -GraphRect.Left, -GraphRect.Top, nil); for I := 0 to Objects.Count - 1 do with Objects do if IsLink then Draw(MetaCanvas); for I := 0 to Objects.Count - 1 do with Objects do if not IsLink then Draw(MetaCanvas); finally MetaCanvas.Free; end; end;

procedure TSimpleGraph.SaveAsMetafile(const Filename: String); var Metafile: TMetafile; begin Metafile := GetAsMetafile; try Metafile.SaveToFile(Filename); finally Metafile.Free; end; end;
У SG есть метод SaveAsMetafile – в метафайл.
Вроде как можно свой метод добавить с TBitmap.
А вообще в BMP сохранять нерационально – картинка может несколько
мегабайт весить, – сжатия,то нет никакого. ИМХО,лучше что-то типа JPEG
применять (подключаете стандартный модуль JPEG).